00100	~    MILISY: THE MINI-LINGUISTIC SYSTEM
00200	~    WRITTEN JANUARY 1972 BY TOM MORAN,
00300	~    COMPUTER SCIENCE DEPARTMENT, CARNEGIE-MELLON UNIVERSITY, PITTSBURGH, PENNSYLVANIA
00400	~    REVISED JULY 1972
00500	~    DOCUMENTATION ON REVISIONS FOUND ON PRDOC[206,CCG],TRACE.DOC[206,CCG]
00600	
00700	~	ADDITIONAL REVISIONS FEBRUARY 1973 BY ARTHUR FLEXSER
00800	~	PSYCHOLOGY DEPARTMENT, STANFORD UNIVERSITY
00900	~	DOCUMENTATION FOUND ON MILDOC[206,AF5]
01000	
01100	~  RECOMMENDED STORAGE ALLOCATION:  CORE=20K; SPEC PDL=3K;
01200	~   REG PDL=3K.
01300	
01400	[PROG ()
01500	
01600	
01700	[DE CONVERSE () (PROG (F TREE)
01800	
01900		(SETQ REPLY @HELLO)
02000	      A (PRINT REPLY)
02100		(LISTEN)
02200		(COND ((ATOM STRING) (TERPRI) (RETURN @BYE))
02300		      ((EQ (CAR STRING) @HOW) (SINGULARIZE (CDDR STRING))))
02400		(SETQ TREE NIL)
02500		(PARSE STRING @<S> @((NIL NIL)))
02600		(COND ((NULL TREE) (SETQ REPLY @(I CANT PARSE YOUR INPUT)) (GO A)))
02700		(SETQ F FACTS)
02800		(COND (FACT-TRACE (TERPRI)
02900			(PRINC @"THE FACT LIST IS INITIALLY:")
03000			(PRINT FACTS)
03100			(TERPRI)))
03200		(COND ((NULL (INTERPRET-S TREE))
03300			(COND ((AND (NOT (EQ FACTS F)) FACT-TRACE)
03400	                  (TERPRI)
03500			  (PRINC @"RESTORING FACT LIST TO:")
03600			  (PRINT F) (SETQ FACTS F) (TERPRI))
03700		      (T (SETQ FACTS F)))))
03800		(GO A)
03900	]
04000	
04100	[DE LISTEN () (PROG2
04200	
04300		(TERPRI) (TERPRI) (PRINC @"**")
04400		(SETQ STRING (READ))
04500	]
04600	
04700	[DF SAY: (L) (SETQ STRING L)]
04800	
04900	[DE PS () (PROG2 (SETQ TREE NIL)
05000	                 (PARSE STRING @<S> @((NIL NIL)))
05100			 (PRINTREE TREE)))
05200	
05300	[DE I () (INTERPRET-S TREE)]
05400	
05500	[DE PSI () (PROG2 (PS) (I))]
05600	
05700	[SETQ TREE-TRACE NIL]
05800	
05900	[SETQ TF-TRACE NIL]
06000	
06100	[DE ATTR (NAME) (READLIST (CONS @% (EXPLODE NAME)))]
06200	
     

00100	[DF P-RULES (L) (PROG (X Y Z)
00200	
00300	      A (COND ((NULL L) (RETURN NIL)))
00400		(SETQ X (REVERSE (CADR L)))
00500		(SETQ Y NIL)
00600		(SETQ Z NIL)
00700	      B (COND ((NULL X)
00800			(SETQ Z (NCONC (LIST @! Y) Z))
00900			(PUTPROP (CAR L) Z @PRULE)
01000			(SETQ L (CDDR L))
01100			(GO A))
01200		      ((EQ (CAR X) @!)
01300			(SETQ Z (CONS Y Z))
01400			(SETQ Y NIL))
01500		      (T (SETQ Y (CONS (CAR X) Y))))
01600		(SETQ X (CDR X))
01700		(GO B)
01800	]
01900	
02000	[P-RULES
02100	
02200	<S> 	(<SD> ! <SE> ! <SQ> ! <SEQ> ! <SWH> ! <SAQ> ! <SLQ>
02300	         ! <SLEQ> ! <SCQ> ! <SCEQ>)
02400	<SD>	(<NP> <VP>)
02500	<VP>	(<COP> <PRED>)
02600	<COP>	(%BE <NEG>)
02700	<PRED>	(<PP> ! <ADJ>)
02800	<SE>	(THERE <COP> <NP> <PP>)
02900	<SQ>	(%BE <NP> <PRED>)
03000	<SEQ>	(%BE THERE <NP> <PP>)
03100	<SWH>	(WHAT <COP> <PRED>)
03200	<SAQ>	(WHAT %ATTR %BE <NP>)
03300	<SLQ>	(WHERE %BE <NP>)
03400	<SLEQ>	(WHERE %BE THERE <NP>)
03500	<SCQ>	(HOW MANY <NP1> <COP> <PRED>)
03600	<SCEQ>	(HOW MANY <NP1> %BE THERE)
03700	<NEG>	(NOT !)
03800	<PP>	(%PREP <NP>)
03900	<NP>	(%DET <NP1>)
04000	<NP1>	(<MOD1> %NOUN <REL-CL>)
04100	<MOD1>	(<ADJ> <MOD1> !)
04200	<ADJ>	(%COLOR ! %SIZE)
04300	<REL-CL>(%WH <COP> <PRED> !)
04400	]
04500	
04600	(DEFPROP %BE (IS ARE) SET)
04700	(DEFPROP %PREP (IN ON UNDER NEAR) SET)
04800	(DEFPROP %DET (THE A) SET)
04900	(DEFPROP %SIZE (BIG SMALL) SET)
05000	(DEFPROP %COLOR (RED BLUE GREEN BLACK) SET)
05100	(DEFPROP %NOUN (BOX BALL BLOCK TABLE FLOOR) SET)
05200	(DEFPROP %WH (WHICH THAT) SET)
05300	(DEFPROP %ATTR (COLOR SIZE) SET)
05400	
05500	[SETQ PLURALS @((BOXES . BOX)(BALLS . BALL)(BLOCKS . BLOCK)
05600	   (TABLES . TABLE)(FLOORS . FLOOR))]
05700	
05800	[DE SINGULARIZE (L) (PROG (X)
05900	    (RETURN
06000		(COND ((SETQ X (ASSOC (CAR L) PLURALS))(RPLACA L (CDR X)))
06100		      ((NULL L) NIL)
06200		      (T (SINGULARIZE (CDR L)))))
06300	]
06400	
06500	(DE PARSE (* G STACK) (PROG (ALTS CLASS)
06600		(COND ((SETQ ALTS (GET G @PRULE))
06700			(RPLACD (CDAR STACK) (LIST (LIST G)))
06800			(RETURN (PAR * (CDR ALTS) (CONS (CADDAR STACK) (CONS
06900				(CONS (CAAR STACK) (CDDAR STACK)) (CDR STACK))))))
07000		  ((SETQ CLASS (GET G @SET))
07100			(COND ((MEMQ (CAR *) CLASS)
07200				(RPLACD (CDAR STACK) (LIST (LIST G (CAR *)))))
07300			  (T (RETURN))))
07400		  ((EQ (CAR *) G) (RPLACD (CDAR STACK) (LIST G)))
07500		  (T (RETURN)))
07600		(NEXT (CDR *) (CONS (CONS (CAAR STACK)(CDDAR STACK))(CDR STACK)))))
07700	
07800	(DE PAR (* ALTS STACK)
07900		(COND ((NULL ALTS))
08000		  ((NULL (CAR ALTS)) (RPLACD (CAR STACK) (LIST NIL))
08100			(NEXT * (CDR STACK)))
08200		  (T (PARSE * (CAAR ALTS) (CONS (CONS (CDAR ALTS) (CAR STACK))
08300			(CDR STACK)))
08400			(PAR * (CDR ALTS) STACK))))
08500	
08600	(DE NEXT (* STACK)
08700		(COND ((AND (NULL *) (NULL (CDR STACK))) (SETQ TREE (CONS
08800			(SUBST 0 0 (CADAR STACK)) TREE)))
08900		  ((NULL (CDR STACK)))
09000		  ((NULL (CAAR STACK)) (NEXT * (CDR STACK)))
09100		  (T (PARSE * (CAAAR STACK) (CONS (CONS (CDAAR STACK) (CDAR STACK))
09200			(CDR STACK))))) )
     

00100	[DE INTERPRET-S (TREE) (PROG (X SUBTREE QUES ATR ABORT)
00200	
00300		(COND (TREE-TRACE (PRINTREE TREE)))
00400		(FINDNODE <S> TREE)
00500		(COND ((NOT (OR (T-SD) (T-SE)
00600	   	   (SETQ QUES (OR (T-SEQ) (T-SQ) (T-SWH)
00700		     (SETQ ATR (T-SAQ)) (T-SLQ) (T-SLEQ)(T-SCQ)(T-SCEQ)))))
00800	               (ERROR1) (RETURN NIL))
00900		      (ABORT (RETURN NIL)))
01000	    NP  (COND ((NULL (FINDNODE <NP> TREE)) NIL)
01100		      ((INTERPRET-NP SUBTREE QUES) (GO NP))
01200		      (T (RETURN NIL)))
01300		(FINDNODE SS TREE)
01400		(COND ((NULL SUBTREE) (GO S))
01500		      ((NOT (OR (T-PRED-ADJ) (T-PRED-PP))) (ERROR1) (RETURN NIL))
01600		      ((NOT (OR (T-NNEG) (T-NEG))) (ERROR1) (RETURN NIL)))
01700	     S  (FINDNODE <S> TREE)
01800		(SETQ X (CDAR SUBTREE))
01900		(COND ((EQ (CAR X) @FIND) (GO FIND))
02000		      ((EQ (CAR X) @RECORD)
02100			(RECORD (CADR X))
02200			(SETQ REPLY @(OKAY)))
02300		      ((EQ (CAR X) @VERIFY)
02400			(SETQ X (VERIFY (CADR X)))
02500			(SETQ REPLY (COND ((NULL X) @(I DONT KNOW)) ((EQ X @TRUE) @(YES)) (T @(NO)))))
02600	              ((EQ (CAR X) @LOCATE) (GO LOCATE))
02700		      ((EQ (CAR X) @COUNT) (GO COUNT))
02800		      (T (ERROR1) (RETURN NIL)))
02900		(RETURN T)
03000	   FIND (SETQ X (EVAL X))
03100		(SETQ REPLY (COND (ATR (COND ((NULL X) @(I DONT KNOW))
03200					     (T X)))
03300				  (T (DESCRIBE X))))
03400		(RETURN T)
03500	 LOCATE	(SETQ X (EVAL X))
03600		(SETQ REPLY (LOCATIONS X))
03700		(RETURN T)
03800	  COUNT (COND ((FINDNODE AND TREE) (T-AND)))
03900		(SETQ X (EVAL X))
04000		(SETQ REPLY (LIST X))
04100		(RETURN T)
04200	]
04300	
04400	[DE INTERPRET-NP (TREE *ANY) (PROG (SUBTREE W X)
04500	
04600		(COND ((EQ (CAR (CDADAR TREE)) @THE) (SETQ *ANY T)))
04700		(FINDNODE <NP1> TREE)
04800		(SETQ W (WORDS SUBTREE))
04900		(COND ((NULL (INTERPRET-NP1 SUBTREE *ANY))(RETURN NIL)))
05000		(SETQ SUBTREE TREE)
05100		(T-NP)
05200		(COND ((T-INDEF) (RETURN (COND ((NULL (CAR SUBTREE))
05300						  (ERROR2) NIL)
05400					       (T (CAR SUBTREE))))))
05500		(T-DEF)
05600		(SETQ X (CAR SUBTREE))
05700		(COND ((NULL X) (ERROR2))
05800		      ((NULL (CDR X)) (RPLACA SUBTREE (CAR X)) (RETURN (CAR X)))
05900		      (T (ERROR3)))
06000	]
06100	
06200	[DE INTERPRET-NP1 (TREE *ANY) (PROG (SUBTREE)
06300	
06400		(SETQ SUBTREE TREE)
06500		(T-NP1)
06600	    ADJ (COND ((T-ADJ) (GO ADJ)))
06700		(T-MOD1)
06800	  BACK	(COND ((T-NREL-CL) (GO ON))
06900		      ((FINDNODE <NP> SUBTREE) (COND
07000			  ((NULL (INTERPRET-NP SUBTREE *ANY)) (RETURN NIL))
07100		          (T (GO BACK))))
07200		      (T (FINDNODE <NP1> TREE)
07300			 (COND ((NULL (T-REL-CL))(ERROR1)(RETURN NIL)))
07400			 (FINDNODE SS SUBTREE)
07500			 (COND ((NOT (OR (T-PRED-ADJ) (T-PRED-PP)))
07600					(ERROR1) (RETURN NIL))
07700			       ((NOT (OR (T-NNEG) (T-NEG)))
07800					(ERROR1) (RETURN NIL)))))
07900	    ON  (FINDNODE AND TREE)
08000	    AND (COND ((T-AND) (GO AND)))
08100		(RETURN T)
08200	]
08300	
08400	[DE ERROR1 () (SETQ REPLY @(I CANT INTERPRET YOUR SENTENCE))]
08500	[DE ERROR2 () (SETQ REPLY (APPEND @(THERE IS NO) W))]
08600	[DE ERROR3 () (SETQ REPLY (APPEND (APPEND @(I DONT KNOW WHICH) W) @(YOU MEAN)))]
08700	
08800	[DF TF (L) (PROG2
08900	
09000		(PUTPROP (CAR L) (CDR L) @TF)
09100		(PUTPROP (CAR L) (LIST @LAMBDA NIL (LIST @TFX (LIST @QUOTE (CAR L)))) @EXPR)
09200	]
09300	
09400	[TF T-SD
09500		(<S> (<SD> 1 (<VP> (<COP> 0 2) 3)))
09600		(<S> RECORD (SS 2 1 3))
09700	]
09800	[TF T-SE
09900		(<S> (<SE> THERE (<COP> 0 1) 2 3))
10000		(<S> RECORD (SS 1 2 (<PRED> 3)))
10100	]
10200	[TF T-SEQ
10300		(<S> (<SEQ> 0 THERE 1 2))
10400		(<S> VERIFY (SS (<NEG> NIL) 1 (<PRED> 2)))
10500	]
10600	[TF T-SQ
10700		(<S> (<SQ> 0 1 2))
10800		(<S> VERIFY (SS (<NEG> NIL) 1 2))
10900	]
11000	[TF T-SWH
11100		(<S> (<SWH> 0 (<COP> 0 1) 2))
11200		(<S> FIND 3 (SS 1 3 2))
11300		(SETV 3 (NEWNUM))
11400	]
11500	[TF T-SAQ
11600		(<S> (<SAQ> WHAT (%ATTR 1) 0 2))
11700		(<S> FIND 3 (4 2 3))
11800		(SETV 4 (ATTR (QUOTE 1)))
11900	]
12000	[TF T-SLQ
12100		(<S> (<SLQ> WHERE 0 1))
12200		(<S> LOCATE 1)
12300	]
12400	[TF T-SLEQ
12500		(<S> (<SLEQ> WHERE 0 THERE 1))
12600		(<S> LOCATE 1)
12700	]
12800	[TF T-SCQ
12900		(<S> (<SCQ> HOW MANY 1 (<COP> 0 2) 3))
13000		(<S> COUNT 4 (AND 5 (SS 2 4 3)))
13100		(PROG2 (COND ((NULL (INTERPRET-NP1 (FINDNODE <NP1> TREE) T))
13200			      (SETQ ABORT T)))
13300		       (SETV 4 (CADAR SUBTREE))
13400		       (SETV 5 (CADDAR SUBTREE))
13500		       (FINDNODE <S> TREE))
13600	]
13700	[TF T-SCEQ
13800		(<S> (<SCEQ> HOW MANY 1 0 THERE))
13900		(<S> COUNT 2 3)
14000		(PROG2 (COND ((NULL (INTERPRET-NP1 (FINDNODE <NP1> TREE) T))
14100			      (SETQ ABORT T)))
14200		       (SETV 2 (CADAR SUBTREE))
14300		       (SETV 3 (CADDAR SUBTREE))
14400		       (FINDNODE <S> TREE))
14500	]
14600	[TF T-PRED-ADJ
14700		(SS 1 2 (<PRED> (<ADJ> (3 4))))
14800		(SS 1 (3 2 4))
14900	]
15000	[TF T-PRED-PP
15100		(SS 1 2 (<PRED> (<PP> (%PREP 3) 4)))
15200		(SS 1 (3 2 4))
15300	]
15400	[TF T-NNEG
15500		(SS (<NEG> NIL) 1)
15600		1
15700	]
15800	[TF T-NEG
15900		(SS (<NEG> NOT) 1)
16000		(NOT 1)
16100	]
16200	[TF T-NP1
16300		(<NP1> 1 (%NOUN 2) 3)
16400		(<NP1> 4 1 3 (ISA 4 2))
16500		(SETV 4 (NEWNUM))
16600	]
16700	[TF T-ADJ
16800		(<NP1> 1 (<MOD1> (<ADJ> (2 3)) 4) 5 6)
16900		(<NP1> 1 4 5 (AND 6 (2 1 3)))
17000	]
17100	[TF T-MOD1
17200		(<NP1> 1 (<MOD1> NIL) 2 3)
17300		(<NP1> 1 2 3)
17400	]
17500	[TF T-NREL-CL
17600		(<NP1> 1 (<REL-CL> NIL) 2)
17700		(<NP1> 1 2)
17800	]
17900	[TF T-REL-CL
18000		(<NP1> 1 (<REL-CL> 0 (<COP> 0 2) 3) 4)
18100		(<NP1> 1 (AND 4 (SS 2 1 3)))
18200	]
18300	[TF T-AND
18400		(AND (AND 1 2) . 3)
18500		(AND 1 2 . 3)
18600	]
18700	[TF T-NP
18800		(<NP> (%DET 1) (<NP1> 2 3))
18900		(<NP> 1 2 3)
19000	]
19100	[TF T-INDEF
19200		(<NP> A 1 2)
19300		3
19400		(PROG2 (SETV 3 (COND (*ANY (FIND 1 2))
19500	                             (T (CREATE 1 2)))) T)
19600	]
19700	[TF T-DEF
19800		(<NP> THE 1 2)
19900		3
20000		(PROG2 (SETV 3 (FIND 1 2)) T)
20100	]
20200	
20300	[DE TFX (R) (PROG (N V X)
20400	
20500		(SETQ N R)
20600		(SETQ R (GET R @TF))
20700		(SETQ V (MATCH NIL (CAR R) (CAR SUBTREE)))
20800		(COND ((NULL V) (RETURN NIL))
20900		      ((NULL (CDDR R)) (GO A)))
21000		(SETQ X (SUBSTITUTE V (CADDR R)))
21100		(COND ((NULL (EVAL X)) (RETURN NIL)))
21200	      A (SETQ X (SUBSTITUTE V (CADR R)))
21300		(RPLACA SUBTREE X)
21400		(COND (TREE-TRACE (PRINT (LIST @APPLY N)) (PRINTREE TREE))
21500		      (TF-TRACE (PRINT N)))
21600		(RETURN T)
21700	]
     

00100	[DE PRINTREE (TREE) (PROG2 (PRINTR (CAR TREE) (LIST NIL)) @*)]
00200	
00300	[DE PRINTR (X M) (PROG ()
00400	
00500		(COND ((NULL X) (PRINC @")") (RETURN NIL)))
00600		(TERPRI)
00700		(MAPC (FUNCTION (LAMBDA (Z) (PRINC @"  "))) M)
00800		(COND ((ATOM X) (PRINC X) (RETURN NIL))
00900		      ((AND (ATOM (CADR X)) (OR (NULL (CDDR X)) (AND
01000			(NULL (CDDDR X)) (ATOM (CADDR X))))) (PRINC X) (RETURN)))
01100		(PRINC @"(") (PRINC (CAR X))
01200		(SETQ M (CONS NIL M))
01300		(MAPC (FUNCTION (LAMBDA (Y) (PRINTR Y M))) (APPEND (CDR X) @(NIL)))
01400	]
01500	
01600	[DE WORDS (X) (PROG (W Z)
01700	
01800		(SETQ Z (LIST NIL))
01900		(SETQ W Z)
02000		(WORD (CAR X))
02100		(RETURN (CDR Z))
02200	]
02300	
02400	[DE WORD (X) (COND
02500	
02600		((ATOM X) (COND ((NULL X) NIL)
02700				((GET X @PRULE) NIL)
02800				((GET X @SET) NIL)
02900				(T (RPLACD W (LIST X)) (SETQ W (CDR W)))))
03000		(T (WORD (CAR X)) (WORD (CDR X)))
03100	]
03200	
03300	
03400	[DE SETV (N X) (SETQ V (CONS (CONS N X) V))]
03500	
03600	[DE NEWNUM () (SETQ NEWNUM (ADD1 NEWNUM))]
03700	
03800	(SETQ NEWNUM 100)
03900	
04000	[DF FINDNODE (N) (PROG (%TREE Y)
04100	
04200		(SETQ %TREE (EVAL (CADR N)))
04300		(SETQ N (CAR N))
04400		(COND ((EQ (CAAR %TREE) N) (RETURN (SETQ SUBTREE %TREE)))
04500		      (T (RETURN (SETQ SUBTREE (FINDNODE1 (CAR %TREE))))))
04600	]
04700	
04800	[DE FINDNODE1 (X) (COND
04900	
05000		((ATOM X) NIL)
05100		((ATOM (CAR X)) (FINDNODE1 (CDR X)))
05200		((EQ (CAAR X) N) X)
05300		((SETQ Y (FINDNODE1 (CAR X))) Y)
05400		(T (FINDNODE1 (CDR X)))
05500	]
05600	
05700	
05800	
05900	[DE MATCH (V F E) (PROG (X) (RETURN (COND ((NULL (MACH F E)) NIL) (V V) (T T))))]
06000	
06100	[DE MACH (F E) (COND
06200	
06300		((EQ F E) T)
06400		((NUMBERP F) (COND ((ZEROP F) T)
06500				   ((SETQ X (ASSOC F V)) (EQUAL (CDR X) E))
06600				   (T (SETQ V (CONS (CONS F E) V)) T)))
06700		((ATOM F) NIL)
06800		((ATOM E) NIL)
06900		(T (AND (MACH (CAR F) (CAR E))
07000			(MACH (CDR F) (CDR E))))
07100	]
07200	
07300	[DE SUBSTITUTE (V X) (PROG (Y) (RETURN (SUBS X)))]
07400	
07500	[DE SUBS (X) (COND
07600	
07700		((NUMBERP X) (COND ((SETQ Y (ASSOC X V)) (CDR Y)) (T X)))
07800		((ATOM X) X)
07900		(T (CONS (SUBS (CAR X)) (SUBS (CDR X))))
08000	]
08100	
08200	[SETQ FACTS NIL]
08300	
08400	[SETQ FACT-TRACE NIL]
08500	
08600	[DE RECORD (S) (COND
08700	
08800		((EQ (CAR S) @AND) (MAPC (FUNCTION RECORD) (CDR S)))
08900		(FACT-TRACE (TERPRI)
09000			(PRINC @"ADDING TO FACT LIST:")
09100			(PRINT S)
09200			(SETQ FACTS (CONS S FACTS))
09300			(TERPRI))
09400		(T (SETQ FACTS (CONS S FACTS)))
09500	]
09600	
09700	[DF CREATE (L) (PROG (X)
09800	
09900		(SETQ X (GENSYM))
10000		(RECORD (SUBSTITUTE (LIST (CONS (CAR L) X)) (CADR L)))
10100		(RETURN X)
10200	]
10300	
10400	[DE VERIFY (S) (PROG (X)
10500	
10600		(COND ((EQ (CAR S) @AND) (GO A))
10700		      ((EQ (CAR S) @OR) (GO B))
10800		      (T (RETURN (VERIFY1 S))))
10900	      A (COND ((NULL (SETQ S (CDR S))) (RETURN @TRUE))
11000		      ((NOT (EQ (SETQ X (VERIFY1 (CAR S))) @TRUE)) (RETURN X)))
11100		(GO A)
11200	      B (COND ((NULL (SETQ S (CDR S))) (RETURN @FALSE))
11300		      ((EQ (VERIFY1 (CAR S)) @TRUE) (RETURN @TRUE)))
11400		(GO B)
11500	]
11600	
11700	[DE VERIFY1 (S) (PROG (F N K Y1 Z1 PR L)
11800	
11900		(SETQ F FACTS)
12000		(COND ((EQ (CAR S) @NOT) (SETQ N (SETQ K (CADR S)))
12100					 (SETQ PR @NOT))
12200		      (T (SETQ N (LIST @NOT S)) (SETQ K S)))
12300		(SETQ Y1 (CADR K))
12400		(SETQ Z1 (CADDR K))
12500		(COND ((AND (ATOM Y1)(ATOM Z1)) (GO A))
12600		      ((ATOM Y1) (SETQ Y1 (LIST Y1)))
12700		      ((ATOM Z1) (SETQ Z1 (LIST Z1))))
12800		(GO B)
12900	     A  (COND ((NULL F) (RETURN NIL))
13000		      ((EQUAL (CAR F) S) (RETURN @TRUE))
13100		      ((EQUAL (CAR F) N) (RETURN @FALSE)))
13200		(SETQ F (CDR F))
13300		(GO A)
13400	     B	(SETQ L (COMBINE (CAR K) Y1 Z1))
13500		(COND (PR (SETQ L (MAPCAR (FUNCTION (LAMBDA (X)
13600					  (CONS PR (LIST X)))) L))))
13700		(RETURN (VERIFY (CONS @OR L)))
13800	]
13900	
14000	[DF FIND (L) (PROG (V X Z)
14100	
14200		(SETQ V (CAR L))
14300		(SETQ L (CADR L))
14400		(SETQ L (COND ((EQ (CAR L) @AND) (CDR L))
14500			      (T (LIST L))))
14600		(SETQ X (FIND1 V (CAR L)))
14700		(COND ((NULL (SETQ L (CDR L))) (RETURN X)))
14800		(SETQ L (CONS @AND L))
14900	      A (COND ((NULL X) (RETURN Z))
15000		      ((EQ (VERIFY (SUBSTITUTE (LIST (CONS V (CAR X))) L)) @TRUE)
15100		       (SETQ Z (CONS (CAR X) Z))))
15200		(SETQ X (CDR X))
15300		(GO A)
15400	]
15500	
15600	[DE FIND1 (M S) (PROG (F X Z PR S1 S2)
15700	
15800		(COND ((EQ (CAR S) @NOT) (SETQ PR @NOT)(SETQ S (CADR S)))
15900		      ((NULL (CADDR S)) (RETURN NIL))
16000		      ((ATOM (CADDR S)) (GO C)))
16100		(SETQ S1 (SUBST (CAADDR S) (CADDR S) S))
16200		(SETQ S2 (SUBST (CDADDR S) (CADDR S) S))
16300		(GO D)
16400	     C  (COND ((NULL (CADR S)) (RETURN NIL))
16500		      ((ATOM (CADR S)) (GO B)))
16600		(SETQ S1 (SUBST (CAADR S)(CADR S) S))
16700		(SETQ S2 (SUBST (CDADR S)(CADR S) S))
16800	     D  (COND (PR (SETQ S1 (CONS PR (LIST S1)))
16900		          (SETQ S2 (CONS PR (LIST S2)))))
17000		(RETURN (UNION (FIND1 M S1) (FIND1 M S2)))
17100	     B	(COND (PR (SETQ S (CONS PR (LIST S)))))
17200		(SETQ F FACTS)
17300	     A  (COND ((NULL F) (RETURN Z)))
17400		(SETQ X (MATCH NIL S (CAR F)))
17500		(SETQ X (ASSOC M X))
17600		(COND (X (SETQ Z (CONS (CDR X) Z))))
17700		(SETQ F (CDR F))
17800		(GO A)
17900	]
18000	
18100	[DE DESCRIBE (L) (PROG (Z)
18200	
18300		(COND ((NULL L) (RETURN @(NOTHING))))
18400		(MAPC (FUNCTION DESCRIBE1) L)
18500		(RETURN (CDR Z))
18600	]
18700	
18800	[DE DESCRIBE1 (X) (PROG (Y)
18900	
19000		(SETQ Y (FIND1 99 (LIST @ISA X 99)))
19100		(SETQ Y (NCONC (FIND1 99 (LIST @%COLOR X 99)) Y))
19200		(SETQ Y (NCONC (FIND1 99 (LIST @%SIZE X 99)) Y))
19300		(SETQ Z (NCONC Y Z))
19400		(SETQ Z (NCONC (LIST @AND @THE) Z))
19500		(RETURN (CDR Z))
19600	]
19700	
19800	[SETQ PREPS (GET @%PREP @SET)]
19900	
20000	[DF LOCATE (X)  (PROG (F Y Z)
20100	
20200		(COND ((ATOM (CAR X))(SETQ X (LIST X))))
20300		(SETQ F FACTS)
20400	     A	(COND ((NULL F) (RETURN Z)))
20500		(SETQ Y (CAR F))
20600		(COND ((NOT (MEMQ (CAR Y) PREPS)) (GO B))
20700		      ((MEMQ (CADR Y) (CAR X)) (SETQ Z (CONS Y Z))))
20800	     B	(SETQ F (CDR F))
20900		(GO A)
21000	]
21100	
21200	[DE LOCATIONS (L) (PROG (Z)
21300	
21400		(COND ((NULL L) (RETURN @(I DONT KNOW))))
21500		(MAPC (FUNCTION LOC1) L)
21600		(RETURN (CDR Z))
21700	]
21800	
21900	[DE LOC1 (X) (PROG (Y)
22000	
22100		(SETQ Y (DESCRIBE1 (CADDR X)))
22200		(SETQ Y (NCONC (LIST (CAR X)) Y))
22300		(SETQ Z (NCONC (LIST @AND) Y))
22400	]
22500	
22600	[DE COMBINE (SP L1 L2)
22700	
22800		(COND ((NULL L2) NIL)
22900		      (T (APPEND (COMBINE SP L1 (CDR L2))
23000			         (COMBINE1 L1 (CAR L2)))))
23100	]
23200	
23300	[DE COMBINE1 (L X)
23400	
23500		(COND ((NULL L) NIL)
23600		      (T (CONS (LIST SP (CAR L) X) (COMBINE1 (CDR L) X))))
23700	]
23800	
23900	[DE UNION (U V)
24000	
24100		(COND ((NULL U) V)
24200		      ((MEMQ (CAR U) V) (UNION (CDR U) V))
24300		      (T (CONS (CAR U) (UNION (CDR U) V))))
24400	]
24500	
24600	[SETQ NUMBERS @((0 . NONE)(1 . ONE)(2 . TWO)(3 . THREE)
24700	     (4 . FOUR)]
24800	
24900	[DF COUNT (L)
25000	
25100		(COND ((*LESS (SETQ L (LENGTH(EVAL (CONS @FIND L)))) 5)
25200			(CDR (ASSOC L NUMBERS)))
25300		      (T L))
25400	]
25500	
     

00100	
00200	(SETQ *NOPOINT T)
00300	(RETURN @"MINI-LINGUISTIC SYSTEM READY")    ]